home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue61 / Stream / uMaker.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-11  |  9.3 KB  |  348 lines
  1. unit uMaker;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, uGLobals, StdCtrls, ExtDlgs, jpeg, ComCtrls, Menus, ActnList,
  8.   ToolWin;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     ListFiles: TListBox;
  13.     Splitter1: TSplitter;
  14.     Panel1: TPanel;
  15.     Panel2: TPanel;
  16.     Panel3: TPanel;
  17.     Panel4: TPanel;
  18.     Panel5: TPanel;
  19.     Splitter2: TSplitter;
  20.     Splitter3: TSplitter;
  21.     Splitter4: TSplitter;
  22.     Splitter5: TSplitter;
  23.     OpenScr: TOpenDialog;
  24.     SaveScr: TSaveDialog;
  25.     OpenPic: TOpenPictureDialog;
  26.     Panel8: TPanel;
  27.     ImagePreview: TImage;
  28.     StatusBar: TStatusBar;
  29.     ActionList: TActionList;
  30.     MainMenu1: TMainMenu;
  31.     File1: TMenuItem;
  32.     List1: TMenuItem;
  33.     CreateNewScreensaver1: TMenuItem;
  34.     LoadExistingScreensaver1: TMenuItem;
  35.     NewScreensaver1: TMenuItem;
  36.     N1: TMenuItem;
  37.     N2: TMenuItem;
  38.     Exit1: TMenuItem;
  39.     AddImage1: TMenuItem;
  40.     DeleteImage1: TMenuItem;
  41.     N3: TMenuItem;
  42.     MoveUp1: TMenuItem;
  43.     MoveDown1: TMenuItem;
  44.     ActionNew: TAction;
  45.     ActionBuild: TAction;
  46.     ActionLoad: TAction;
  47.     ActionAddImage: TAction;
  48.     ActionDeleteImage: TAction;
  49.     ActionUp: TAction;
  50.     ActionDown: TAction;
  51.     Panel6: TPanel;
  52.     eText: TEdit;
  53.     procedure btnExitClick(Sender: TObject);
  54.     procedure btnAddClick(Sender: TObject);
  55.     procedure ListFilesClick(Sender: TObject);
  56.     procedure btnDeleteClick(Sender: TObject);
  57.     procedure btnUpClick(Sender: TObject);
  58.     procedure btnDownClick(Sender: TObject);
  59.     procedure btnCreateClick(Sender: TObject);
  60.     procedure btnLoadClick(Sender: TObject);
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure FormDestroy(Sender: TObject);
  63.     procedure btnNewClick(Sender: TObject);
  64.   private
  65.     TempPath : string;
  66.     OldName : String;
  67.     CurrentFilename : string;
  68.     FilesToDelete : TStringList;
  69.     pb : TProgressBar;
  70.   public
  71.     { Public declarations }
  72.   end;
  73.  
  74. var
  75.   Form1: TForm1;
  76.  
  77. implementation
  78.  
  79. {$R *.DFM}
  80.  
  81. procedure TForm1.btnExitClick(Sender: TObject);
  82. begin
  83.   Application.Terminate;
  84. end;
  85.  
  86. procedure TForm1.btnAddClick(Sender: TObject);
  87. var
  88.   i : integer;
  89. begin
  90.   if OpenPic.Execute then
  91.   begin
  92.     for i := 0 to OpenPic.Files.Count-1 do
  93.        ListFiles.Items.Add(OpenPic.Files[i]);
  94.   end;
  95.   if (ListFiles.ItemIndex = -1) and (ListFiles.Items.Count > 0) then
  96.   begin
  97.      if ListFiles.ItemIndex > 0 then
  98.         OldName := ListFiles.Items[ListFiles.ItemIndex];
  99.      ListFiles.ItemIndex := 0;
  100.      if OldName <> ListFiles.Items[ListFiles.ItemIndex] then
  101.         ListFilesClick(ListFiles);
  102.   end;
  103.   ActionBuild.Enabled := True;
  104. end;
  105.  
  106. procedure TForm1.ListFilesClick(Sender: TObject);
  107. begin
  108.   if ListFiles.ItemIndex >=0 then
  109.   begin
  110.     ImagePreview.Visible := False;
  111.     ImagePreview.Picture.LoadFromFile(ListFiles.Items[ListFiles.ItemIndex]);
  112.     ImagePreview.Visible := True;
  113.     ActionDeleteImage.Enabled := True;
  114.     ActionUp.Enabled := True;
  115.     ActionDown.Enabled := True;
  116.   end else
  117.   begin
  118.     ActionDeleteImage.Enabled := False;
  119.     ActionUp.Enabled := False;
  120.     ActionDown.Enabled := False;
  121.   end;
  122. end;
  123.  
  124. procedure TForm1.btnDeleteClick(Sender: TObject);
  125. var
  126.   i : integer;
  127. begin
  128.   i := ListFiles.ItemIndex;
  129.   if ListFiles.ItemIndex >= 0 then
  130.      ListFiles.Items.Delete(i);
  131.   if i > ListFiles.Items.Count-1 then
  132.      dec(i);
  133.   if i > ListFiles.Items.Count-1 then
  134.      i := -1;
  135.   if ListFiles.ItemIndex > 0 then
  136.      OldName := ListFiles.Items[ListFiles.ItemIndex];
  137.   ListFiles.ItemIndex := i;
  138.   if OldName <> ListFiles.Items[ListFiles.ItemIndex] then
  139.      ListFilesClick(ListFiles);
  140.   ActionBuild.Enabled := True;
  141. end;
  142.  
  143. procedure TForm1.btnUpClick(Sender: TObject);
  144. var
  145.   i : integer;
  146. begin
  147.   i := ListFiles.ItemIndex-1;
  148.   if i < 0 then
  149.      i := ListFiles.Items.Count-1;
  150.   if ListFiles.ItemIndex >= 0 then
  151.   begin
  152.      ListFiles.Items.Move(ListFiles.ItemIndex,i);
  153.      ListFiles.ItemIndex := i;
  154.      ActionBuild.Enabled := True;
  155.   end;
  156. end;
  157.  
  158. procedure TForm1.btnDownClick(Sender: TObject);
  159. var
  160.   i : integer;
  161. begin
  162.   i := ListFiles.ItemIndex+1;
  163.   if i = ListFiles.Items.Count then
  164.      i := 0;
  165.   if ListFiles.ItemIndex >= 0 then
  166.   begin
  167.      ListFiles.Items.Move(ListFiles.ItemIndex,i);
  168.      ListFiles.ItemIndex := i;
  169.      ActionBuild.Enabled := True;
  170.   end;
  171. end;
  172.  
  173. procedure TForm1.btnCreateClick(Sender: TObject);
  174. var
  175.   fsSS : TFileStream;
  176.   fsOut : TFileStream;
  177.   i, listloc : integer;
  178.   buf : array[0..19] of Char;
  179.   s : string;
  180.   ssi : TSSImage;
  181.   sil : TSSFileImageLocations;
  182.   bShowText : boolean;
  183. begin
  184.   if SaveScr.Execute then
  185.   begin
  186.     sil := TSSFileImageLocations.Create(nil);
  187.     fsSS := TFileStream.Create(ExtractFilePath(Application.ExeName)+'ScreenSaver.dat',fmOpenRead or fmShareDenyWrite);
  188.     fsOut := TFileStream.Create(SaveScr.FileName,fmCreate);
  189.     try
  190.       StatusBar.Panels[1].Text := 'Creating...';
  191.       fsOut.CopyFrom(fsSS,fsSS.Size);
  192.       pb.Max := ListFiles.Items.Count -1;
  193.       for i := 0 to ListFiles.Items.Count -1 do
  194.       begin
  195.         pb.Position := i;
  196.         bShowText := not bShowText;
  197.         if bShowText and (eText.Text <> '') then
  198.         begin
  199.           ssi := TSSTextImage.Create(nil);
  200.           TSSTextImage(ssi).Text := eText.Text;
  201.         end else
  202.         begin
  203.           ssi := TSSImage.Create(nil);
  204.         end;
  205.         try
  206.           ssi.Picture.LoadFromFile(ListFiles.Items[i]);
  207.           ssi.Filename := ExtractFileName(ListFiles.Items[i]);
  208.           sil.Add(fsOut.Position);
  209.           fsOut.WriteComponent(ssi);
  210.         finally
  211.           ssi.Free;
  212.         end;
  213.       end;
  214.       listLoc := fsOut.Position;
  215.       fsOut.WriteComponent(sil);
  216.  
  217.       s := IntToStr(fsOut.Size-fsSS.Size);
  218.       while length(s)<20 do
  219.          s := s+' ';
  220.       for i := 0 to 19 do
  221.          buf[i] := s[i+1];
  222.       fsOut.WriteBuffer(Buf,20);
  223.  
  224.       s := IntToStr(listLoc);
  225.       while length(s)<20 do
  226.          s := s+' ';
  227.       for i := 0 to 19 do
  228.          buf[i] := s[i+1];
  229.       fsOut.WriteBuffer(Buf,20);
  230.  
  231.     finally
  232.       sil.Free;
  233.       fsSS.Free;
  234.       fsOut.Free;
  235.     end;
  236.      CurrentFilename := ExtractFileName(SaveScr.Filename);
  237.   end;
  238.   pb.Position := 0;
  239.   StatusBar.Panels[1].Text := CurrentFilename;
  240. end;
  241.  
  242. procedure TForm1.btnLoadClick(Sender: TObject);
  243. var
  244.   fs : TFileStream;
  245.   iListLoc, iMax, iSize, i, j : integer;
  246.   Buf : array[0..19] of Char;
  247.   ssi : TSSImage;
  248.   sil : TSSFileImageLocations;
  249. begin
  250.   if OpenScr.Execute then
  251.   begin
  252.      if ListFiles.Items.Count > 0 then
  253.         if MessageDlg('Are you sure you wish to load '+OpenScr.Filename+' and clear the current ScreenSaver?',mtConfirmation,[mbYes, mbNo],0)=mrNo then exit;
  254.      ListFiles.Clear;
  255.      ImagePreview.Visible := False;
  256.      sil := TSSFileImageLocations.Create(nil);
  257.      fs := TFileStream.Create( OpenScr.Filename, fmOpenRead or fmShareDenyWrite );
  258.      try
  259.        StatusBar.Panels[1].Text := 'Loading...';
  260.        fs.Position := fs.Size-40;
  261.        j := fs.Read(Buf,20);
  262.        if j <> 20 then exit;
  263.        iSize := StrToIntDef(Trim(buf),0);
  264.  
  265.        j := fs.Read(Buf,20);
  266.        if j <> 20 then exit;
  267.        iListLoc := StrToIntDef(Trim(buf),0);
  268.  
  269.        fs.Position := iListLoc;
  270.        sil := TSSFileImageLocations(fs.ReadComponent(sil));
  271.        iMax := sil.Count;
  272.  
  273.        fs.Position := fs.Size-iSize-40;
  274.  
  275.        pb.Max := iMax-1;
  276.        for i := 0 to iMax-1 do
  277.        begin
  278.           pb.position := i;
  279.           Application.ProcessMessages;
  280.           ssi := TSSImage(fs.ReadComponent(nil));
  281.           try
  282.             TSSImage(ssi).Picture.SaveToFile(TempPath+'~'+TSSImage(ssi).Filename);
  283.             FilesToDelete.Add(TempPath+'~'+TSSImage(ssi).Filename);
  284.             ListFiles.Items.Add(TempPath+'~'+TSSImage(ssi).Filename);
  285.           finally
  286.             TSSImage(ssi).Free;
  287.           end;
  288.        end;
  289.        if ListFiles.Items.Count>0 then
  290.        begin
  291.          ListFiles.ItemIndex := 0;
  292.          ListFilesClick(ListFiles);
  293.        end;
  294.      finally
  295.        fs.free;
  296.        sil.Free;
  297.      end;
  298.      CurrentFilename := ExtractFileName(OpenScr.Filename);
  299.   end;
  300.   pb.position := 0;
  301.   StatusBar.Panels[1].Text := CurrentFilename;
  302.   ActionBuild.Enabled := False;
  303. end;
  304.  
  305. procedure TForm1.FormCreate(Sender: TObject);
  306. begin
  307.   FilesToDelete := TStringList.Create;
  308.   TempPath := StringOfChar(' ',MAX_PATH);
  309.   GetTempPath(MAX_PATH,PChar(TempPath));
  310.   TempPath := Trim(TempPath);
  311.   pb := TProgressBar.Create(StatusBar);
  312.   pb.Parent := StatusBar;
  313.   pb.Left := 2;
  314.   pb.Top := 2;
  315.   pb.width := 198;
  316.   pb.height := 17;
  317.   pb.Smooth := True;
  318.   pb.Position := 0;
  319.   CurrentFilename := 'NewScreenSaver.scr';
  320.   StatusBar.Panels[1].Text := CurrentFilename;
  321. end;
  322.  
  323. procedure TForm1.FormDestroy(Sender: TObject);
  324. var
  325.   i : integer;
  326. begin
  327.   for i := 0 to FilesToDelete.Count-1 do
  328.     DeleteFile(FilesToDelete[i]);
  329.   FilesToDelete.Free;
  330. end;
  331.  
  332. procedure TForm1.btnNewClick(Sender: TObject);
  333. begin
  334.   if ListFiles.Items.Count > 0 then
  335.   begin
  336.      if MessageDlg('Are you sure you wish to clear the current screensaver?',mtConfirmation,[mbYEs, mbNo],0)=mrYes then
  337.      begin
  338.         ListFiles.Clear;
  339.         ImagePreview.Visible := False;
  340.         CurrentFilename := 'NewScreenSaver.scr';
  341.         StatusBar.Panels[1].Text := CurrentFilename;
  342.      end;
  343.      ActionBuild.Enabled := False;
  344.   end;
  345. end;
  346.  
  347. end.
  348.